home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / c / bpreal.exe / BPREAL.C < prev    next >
Encoding:
C/C++ Source or Header  |  1993-04-19  |  5.0 KB  |  159 lines
  1. /*                BPREAL                */
  2. /* Borland Pascal Real-Type Conversions */
  3. /*           by Richard Biffl           */
  4.  
  5.  
  6. typedef unsigned real[3];
  7.  
  8. union doublearray {
  9.     double d;
  10.     unsigned a[4];
  11. };
  12.  
  13. enum prconverr {
  14.     prOK,             /* correct conversion (may be rounded) */
  15.     prPosUnderflow,   /* pos. value, too small for Real */
  16.     prNegUnderflow,   /* neg. value, too small for Real */
  17.     prOverflow,       /* exponent too large for Real */
  18.     prInf,            /* IEEE infinity, pos. or neg. */
  19.     prNaN             /* IEEE NaN, not a number, e.g. sqrt(-1.0) */
  20. } ;
  21.  
  22.  
  23. double real_to_double (real r);
  24.  
  25. enum prconverr double_to_real (double d, real *r);
  26.  
  27.  
  28. double real_to_double (real r)
  29. /* takes Pascal real, return C double */
  30. {
  31.     union doublearray da;
  32.     unsigned x;
  33.  
  34.     x = r[0] & 0x00FF;  /* Real biased exponent in x */
  35.     /* when exponent is 0, value is 0.0 */
  36.     if (x == 0)
  37.         da.d = 0.0;
  38.     else {
  39.         da.a[3] = ((x + 894) << 4) |  /* adjust exponent bias */
  40.                   (r[2] & 0x8000) |  /* sign bit */
  41.                   ((r[2] & 0x7800) >> 11);  /* begin significand */
  42.         da.a[2] = (r[2] << 5) |  /* continue shifting significand */
  43.                   (r[1] >> 11);
  44.         da.a[1] = (r[1] << 5) |
  45.                   (r[0] >> 11);
  46.         da.a[0] = (r[0] & 0xFF00) << 5; /* mask real's exponent */
  47.     }
  48.     return da.d;
  49. }
  50.  
  51.  
  52. enum prconverr double_to_real (double d, real *r)
  53. /* converts C double to Pascal real, returns error code */
  54. {
  55.     union doublearray da;
  56.     unsigned x;
  57.  
  58.     da.d = d;
  59.  
  60.     /* check for 0.0 */
  61.     if ((da.a[0] == 0x0000) &&
  62.         (da.a[1] == 0x0000) &&
  63.         (da.a[2] == 0x0000) &&
  64.         /* ignore sign bit */
  65.         ((da.a[3] & 0x7FFF) == 0x0000)) {
  66.         /* exponent and significand are both 0, so value is 0.0 */
  67.         (*r)[2] = (*r)[1] = (*r)[0] = 0x0000;
  68.         /* sign bit is ignored ( -0.0 -> 0.0 ) */
  69.         return prOK;
  70.     }
  71.  
  72.     /* test for maximum exponent value */
  73.     if ((da.a[3] & 0x7FF0) == 0x7FF0) {
  74.         /* value is either Inf or NaN */
  75.         if ((da.a[0] == 0x0000) &&
  76.             (da.a[1] == 0x0000) &&
  77.             (da.a[2] == 0x0000) &&
  78.             ((da.a[3] & 0x000F) == 0x0000)) {
  79.             /* significand is 0, so value is Inf */
  80.             /* value becomes signed maximum real, */
  81.             /* and error code prInf is returned */
  82.             (*r)[1] = (*r)[0] = 0xFFFF;
  83.             (*r)[2] = 0x7FFF |
  84.                       (da.a[3] & 0x8000); /* retain sign bit */
  85.             return prInf;
  86.         } else {
  87.             /* significand is not 0, so value is NaN */
  88.             /* value becomes 0.0, and prNaN code is returned */
  89.             /* sign bit is ignored (no negative NaN) */
  90.             (*r)[2] = (*r)[1] = (*r)[0] = 0x0000;
  91.             /* sign bit is ignored ( -NaN -> +NaN ) */
  92.             return prNaN;
  93.         }
  94.     }
  95.  
  96.     /* round significand if necessary */
  97.     if ((da.a[0] & 0x1000) == 0x1000) {
  98.         /* significand's 40th bit set, so round significand up */
  99.         if ((da.a[0] & 0xE000) != 0xE000)
  100.             /* room to increment 3 most significant bits */
  101.             da.a[0] += 0x2000;
  102.         else {
  103.             /* carry bit to next element */
  104.             da.a[0] = 0x0000;
  105.             /* carry from 0th to 1st element */
  106.             if (da.a[1] != 0xFFFF)
  107.                 da.a[1]++;
  108.             else {
  109.                 da.a[1] = 0x0000;
  110.                 /* carry from 1st to 2nd element */
  111.                 if (da.a[2] != 0xFFFF)
  112.                     da.a[2]++;
  113.                 else {
  114.                     da.a[2] = 0x0000;
  115.                     /* carry from 2nd to 3rd element */
  116.                     /* significand may overflow into exponent */
  117.                     /* exponent not full, so won't overflow */
  118.                     da.a[3]++;
  119.                 }
  120.             }
  121.         }
  122.     }
  123.  
  124.     /* get exponent for underflow/overflow tests */
  125.     x = (da.a[3] & 0x7FF0) >> 4;
  126.  
  127.     /* test for underflow */
  128.     if (x < 895) {
  129.         /* value is below real range */
  130.         (*r)[2] = (*r)[1] = (*r)[0] = 0x0000;
  131.         if ((da.a[3] & 0x8000) == 0x8000)
  132.             /* sign bit was set, so value was negative */
  133.             return prNegUnderflow;
  134.         else
  135.             /* sign bit was not set */
  136.             return prPosUnderflow;
  137.     }
  138.  
  139.     /* test for overflow */
  140.     if (x > 1149) {
  141.         /* value is above real range */
  142.         (*r)[1] = (*r)[0] = 0xFFFF;
  143.         (*r)[2] = 0x7FFF | (da.a[3] & 0x8000); /* retain sign bit */
  144.         return prOverflow;
  145.     }
  146.  
  147.     /* value is within real range */
  148.     (*r)[0] = (x - 894) |  /* re-bias exponent */
  149.               ((da.a[0] & 0xE000) >> 5) |  /* begin significand */
  150.               (da.a[1] << 11);
  151.     (*r)[1] = (da.a[1] >> 5) |
  152.               (da.a[2] << 11);
  153.     (*r)[2] = (da.a[2] >> 5) |
  154.               ((da.a[3] & 0x000F) << 11) |
  155.               (da.a[3] & 0x8000);  /* copy sign bit */
  156.     return prOK;
  157.  
  158. }
  159.